home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr52 / 5333de.zip / 2.PRG < prev    next >
Text File  |  1993-04-03  |  867b  |  41 lines
  1. // Update the client files CA of the Pears
  2. // This variation takes APPEND out of the loop.
  3.  
  4. clear
  5. private I
  6.  
  7. Select A
  8. Use CA
  9. zap
  10. append blank
  11. FOR I = 1 TO 6000
  12.    Replace CAID     with NEW_ID("CA")
  13.    ? "REC#"+str(I,4)+"   "
  14.    ?? "string= "+str(memory(0),4)+"K  "+;
  15.                 "free  = "+str(memory(1),4)+"K  "+;
  16.                 "run   = "+str(memory(2),4)+"K  "+;
  17.                 "EMM   = "+str(memory(3),4)+"K  "
  18. next
  19.  
  20. Function NEW_ID(P1)
  21. ***************************************
  22. *
  23. ***************************************
  24. private   R,;   && returns the latest ID
  25.           W,;  && saves the previous workarea chosen
  26.           D
  27.  
  28. W = select()
  29. use IDS NEW
  30. locate for DS == PadR(P1, 8)
  31. if found()
  32.       D = val(NEWID)+1
  33.       R := PadL( D, len(trim(NEWID)), "0")
  34.       replace NEWID with R
  35. endif
  36.  
  37. use
  38. select (W)
  39. return R
  40.  
  41.